EnigmA Amiga Run 1995 October/EnigmA AMIGA RUN 01 (1995)(G.R. Edizioni)(IT)[!][issue 1995-10][Aminet 7].iso/Aminet/comm/mail/thor201.lha/THOR_2.0/thor.lha/rexx/SortMail.thor

Text File | 1995-05-15 | 18KB | 601 lines

/*
** $VER: SortMail.thor 1.4 (2.5.95) Eirik Synnes
**
** Some code borrowed from  AddSOUP.thor      by Magne Østlyngen
**                     and  AddAmiNetList.br  by Petter Nilsen
**
** Todo:  Test ShowMessage
**        Use from field for finding mailing list msgs
**        UUDecode Amiga Link
**        Use copyback cache more efficiently
**        Check for duplicate entries in the filebase
**        Support SuperUnread flag in mailing list msgs (waiting for support...)
**        Mark Amiga Report as read (waiting for support...)
**
** Ideas: Parse messages from the Usenet Oracle
**
*/

options results

signal on break_c
signal on halt

/* Initialize some variables */
system = ""; mailconf = ""
aminet = ""; amirep = ""; checkcc= 0; stats = 0
mlcount = 0; dgcount = 0
mlfound = 0; dgparsed = 0 ; dgsubmsgs = 0; rparsed = 0; rfiles = 0; aruu = 0;
progwin = 0; delnew = 0

MDB_DELETED             =  5  /* Message is deleted. */

/* Find Thor and BBSREAD ARexx ports' */
p=address()||' '||show('P',,);if pos('THOR.',p)>0 then thorport=word(substr(p,pos('THOR.',p)),1);else do;say 'No THOR port found!';exit(0);end
if ~show('p', 'BBSREAD') then do; address command; "run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead"; "WaitForPort BBSREAD"; end

/* See if another copy of SortMail is already running */
if exists("T:SortMail.tmp") then do
 REQUESTNOTIFY '"Another copy of SortMail\nis probably running."' '"_Continue|_Abort"'
 if result = 0 then exit(0)
 end

call open(tmp, "T:SortMail.tmp", 'W'); call close(tmp)

/* Get the path of the configuration file */
call open(pn, 'ENV:Thor/THORPATH', 'R')
thorpath = readln(pn)
call close(pn)

if ~exists(thorpath'rexx') then cfgfile = 'ENV:Thor/SortMail.cfg'
else cfgfile = thorpath'rexx/SortMail.cfg'

if ~exists(cfgfile) then do
 REQUESTNOTIFY '"Couldn''t find config file ('cfgfile').\nPlease run CfgSortMail.thor and try again."' '"Abort"'
 call cleanup
 end

/* Check if user has entered a system or is in the startup window */
address(thorport)
CURRENTBBS STEM bbs
if rc = 1 then do
 REQUESTNOTIFY '"Enter your configured system\nbefore running this script."' '"Abort"'
 call cleanup
 end
else if rc ~= 0 then do
 REQUESTNOTIFY '"'THOR.LASTERROR'"' '"Abort"'
 call cleanup
 end

/* Read configuration */
call readcfg

if system ~= bbs.BBSNAME then call cleanup

/* Get some info on the system */
address(bbsread)
GETCONFLIST BBSNAME '"'system'"' STEM conflist
if rc ~=0 then do
 address(thorport)
 REQUESTNOTIFY '"'BBSREAD.LASTERROR'"' '"Abort"'
 call cleanup
 end

address(thorport)
GETMESSAGEARRAY '"'mailconf'"' msgs LS
if rc = 5 then do
 call cleanup
 end
else if rc ~= 0 then do
 REQUESTNOTIFY '"'THOR.LASTERROR'"' '"Abort"'
 call cleanup
 end

/* Exit if there are no messages to process */
if msgs.count = 0 then call cleanup

OPENPROGRESS TITLE '"Sorting messages..."' TOTAL msgs.count AT "_Abort" PROGRESSCHARWIDTH 38
progwin = result

/* Start of main loop */
do curr = 1 to msgs.count
 msgfini = 0; textread = 0

 /* Update progressbar */
 address(thorport)
 UPDATEPROGRESS REQ progwin CURRENT curr PT '"Message 'curr' of 'msgs.count' (OrgMsg: 'msgs.curr')"'

 /* Read message data */
 address(bbsread)
 drop data. head.
 READBRMESSAGE '"'system'"' '"'mailconf'"' msgs.curr DATASTEM data HEADSTEM head
 if rc ~= 0 then do
  address(thorport)
  REQUESTNOTIFY '"Couldn''t read msg #'msgs.curr':\n'BBSREAD.LASTERROR'"' '"_Ok"'
  call cleanup
  end

 if bittst(data.FLAGS,MDB_DELETED) then msgfini = 1

 /* Check if message is part of a mailing list */
 if mlcount > 0 then do
  do m = 1 to mlcount until msgfini = 1
   searchaddr = upper(compress(head.TOADDR, ',<>()"'))
   do n = 1 to mlist.m.addrcount until msgfini = 1
    if find(searchaddr, upper(mlist.m.toaddr.n)) > 0 then do
     call movemsg(msgs.curr, mlist.m.name, mlist.m.replyaddr)
     mlfound = mlfound + 1
     msgfini = 1
     end
    end
   if msgfini = 0 then do n = 1 to mlist.m.namecount until msgfini = 1
    if upper(head.TONAME) = upper(mlist.m.toname.n) then do
     call movemsg(msgs.curr, mlist.m.name, mlist.m.replyaddr)
     mlfound = mlfound + 1
     msgfini = 1
     end
    end
   end
  end

 if msgfini = 1 then iterate curr

 /* Check if message is a digest */
 if dgcount > 0 then do
  do m = 1 to dgcount until msgfini = 1
   do n = 1 to digest.m.addrcount until msgfini = 1
    if find(upper(head.TOADDR), upper(digest.m.toaddr.n)) > 0 then do
     call parsedigest(msgs.curr, digest.m.name, digest.m.replyaddr, digest.m.endsubmsg, digest.m.enddigest, digest.m.deldigest)
     dgparsed = dgparsed + 1
     msgfini = 1
     end
    end
   if msgfini = 0 then do n = 1 to digest.m.namecount until msgfini = 1
    if upper(head.TONAME) = upper(digest.m.toname.n) then do
     call parsedigest(msgs.curr, digest.m.name, digest.m.replyaddr, digest.m.endsubmsg, digest.m.enddigest, digest.m.deldigest)
     dgparsed = dgparsed + 1
     msgfini = 1
     end
    end
   end
  end

 if msgfini = 1 then iterate curr

 select
  /* Check if message is a aminet recent message */
  when head.TOADDR = aminet then call parseaminet(msgs.curr)

  /* Check if message contains amiga report (not implemented yet) */
  when head.FROMADDR = amirep then do
   if exists(thorpath'rexx/UUDecode.thor') then do
    address(thorport)
    SAVEMESSAGE BBSNAME '"'system'"' CONFNAME '"'mailconf'"' MSGNUMBER msgs.curr NOHEADER NOANSI FILENAME '"T:AmiRep.uu"'
    address(command)
    'rx 'thorpath'rexx/UUDecode.thor T:AmiRep.uu'
    aruu = aruu + 1
    end
   else do
    address(thorport)
    REQUESTNOTIFY '"Couldn''t uudecode Amiga Report:\n'thorpath'rexx/UUDecode.thor not found."' '"I see."'
    end
   end

  otherwise if msgfini = 0 then do
   /* Check Cc:, Resent-To: and Apparently-To fields */
   if checkcc = 1 then do
    drop text.
    address(bbsread)
    READBRMESSAGE '"'system'"' '"'mailconf'"' msgs.curr TEXTSTEM text
    textread = 1
    if text.COMMENT.COUNT > 0 then do n = 1 to text.COMMENT.COUNT
     if upper(left(text.COMMENT.n, 3)) = 'CC:' | upper(left(text.COMMENT.n, 14)) = 'APPARENTLY-TO:' | upper(left(text.COMMENT.n, 10)) = 'RESENT-TO:' then do m = 1 to mlcount until msgfini = 1
      ccs = upper(compress(subword(text.COMMENT.n, 2), ',<>()'))
      do o = 1 to mlist.m.addrcount until msgfini = 1
       if find(ccs, upper(mlist.m.toaddr.o)) > 0 then do
        call movemsg(msgs.curr, mlist.m.name, mlist.m.replyaddr)
        mlfound = mlfound + 1
        msgfini = 1
        end
       end
      end
     end
    end
   end
  end
 end

cnt = 1
if mlfound > 0 | dgparsed > 0 | rparsed > 0 & stats = 1 then do
 msgstem.TEXT.cnt = 'Sortmail processed 'msgs.count' message(s) and found:'; cnt = cnt + 1
 msgstem.TEXT.cnt = ''; cnt = cnt + 1
 if mlfound > 0 then do; msgstem.TEXT.cnt = mlfound' maillist message(s)'; cnt = cnt + 1; end
 if dgparsed > 0 then do; msgstem.TEXT.cnt = dgparsed' digest message(s) containing 'dgsubmsgs' sub-message(s)'; cnt = cnt + 1; end
 if rparsed > 0 then do; msgstem.TEXT.cnt = rparsed' AmiNet RECENT message(s) reporting 'rfiles' new files'; cnt = cnt + 1; end
 end
if amirep ~= '' & aruu > 0 then do; msgstem.TEXT.cnt = 'AmigaReport (uudecoded and put in your download directory)'; cnt = cnt + 1; end

msgstem.TEXT.COUNT = cnt - 1
if msgstem.TEXT.COUNT > 0 then call writemsg

/* Update message list in Thor if the user is in the E-Mail conference */
address(thorport)
CURRENTBBS STEM bbs
if bbs.CONFNAME = mailconf then SHOWCONFERENCE '"'mailconf'"'
UPDATECONFWINDOW

break_c:
halt:
call cleanup


/*
** Procedures
*/

writemsg: procedure expose thorport system mailconf msgstem.
address(bbsread)
GETBBSDATA '"'system'"' bbsdata
msgstem.FROMNAME = bbsdata.USERNAME
msgstem.TONAME = bbsdata.USERNAME
msgstem.SUBJECT = 'SortMail results'
WRITEBRMESSAGE '"'system'"' '"'mailconf'"' STEM msgstem
return


parsedigest: procedure expose thorport system mailconf conflist. data. head. dgsubmsgs
             parse arg number, toconf, repaddr, endsubmsg, enddigest, deldigest

address(bbsread)
READBRMESSAGE '"'system'"' '"'mailconf'"' number TEXTSTEM text
if rc ~= 0 then do
 address(thorport)
 REQUESTNOTIFY '"Couldn''t read msg #'msgs.curr':\n'BBSREAD.LASTERROR'"' '"_Ok"'
 return
 end

line = 1

BUFMODE COPYBACK

do forever
 drop newmsg.
 newmsg.msgid = head.msgid
 newmsg.replyconf = mailconf
 newmsg.replyaddr = repaddr
 newmsg.text.count = 0
 fromline = 0; subjline = 0; dateline = 0
 counted = 0; msgoffset = 0

 do until counted = 3
  select
   when upper(left(text.text.line, 5)) = "FROM:" then do
    counted = counted + 1 ; fromline = line ; end
   when upper(left(text.text.line, 8)) = "SUBJECT:" then do
    counted = counted + 1 ; subjline = line ; end
   when upper(left(text.text.line, 5)) = "DATE:" then do
    counted = counted + 1 ; dateline = line; end
   when msgoffset > 100 then do
    BUFMODE ENDCOPYBACK; address(thorport); REQUESTNOTIFY '"Failed to parse digest."' '"_Ok"'; return; end

   when line > text.text.count then do
    drop data. head. text.
    if deldigest = 1 then do
     address(bbsread); UPDATEBRMESSAGE '"'system'"' '"'mailconf'"' number SETDELETED
     BUFMODE ENDCOPYBACK
     if rc ~= 0 then do
      address(thorport); REQUESTNOTIFY '"Couldn''t delete message #'number':\n'BBSREAD.LASTERROR'"' '"_Ok"'; end
     end
    return
    end

   otherwise nop
   end

   line = line + 1; msgoffset = msgoffset + 1
  end

 newmsg.subject = "<no subject>"
 newmsg.fromname = "Unknown"
 newmsg.fromaddr = "<no address>"

 from = strip(substr(text.text.fromline, 6))
 from = translate(from, '<>', '()')
 i=pos("<", from)
 if i ~= 0 then do
  checkaddr = strip(substr(from, i, pos('>',from)-i), B, ' <>"')
  if pos("@", checkaddr) = 0 then do
   newmsg.fromname = checkaddr
   newmsg.fromaddr = strip(delstr(from, i, pos('>',from)-i), B, ' >')
   end
  else do
   newmsg.fromaddr = checkaddr
   newmsg.fromname = strip(delstr(from, i, pos('>',from)-i), B, ' ">')
   end
  end
 else do
  if pos("@", from) = 0 then do
   newmsg.fromname = strip(from, B, ' "')
   end
  else do
   newmsg.fromaddr = strip(from, B, ' "')
   end
  end

 newmsg.subject = strip(substr(text.text.subjline, 9))
 newmsg.creationdatetxt = strip(substr(text.text.dateline, 6))

 do until text.text.line ~= ''
  line = line + 1
  end

 firstline = line
 newmsg.text.count = 0
 msgline = 0

 do until compare(upper(endsubmsg), upper(text.text.line)) = 0
  if line = text.text.count then break
  msgline = msgline + 1
  newmsg.text.count = newmsg.text.count + 1
  newmsg.text.msgline = text.text.line
  line = line + 1
  end

 address(bbsread)
 WRITEBRMESSAGE '"'system'"' '"'toconf'"' STEM newmsg
 if rc ~= 0 then do
  address(thorport)
  REQUESTNOTIFY '"'BBSREAD.LASTERROR'"' '"_Ok"'
  end
 else dgsubmsgs = dgsubmsgs + 1
 end


movemsg: procedure expose thorport system mailconf conflist. data. head. text. textread
         parse arg number, toconf, repaddr

CDF_NOT_ON_BBS          = '00008000'x  /* This conference is not on the bbs. */

priv = ""; urg = ""; imp = ""; kep = ""; repl = ""

if textread = 0 then do
 READBRMESSAGE '"'system'"' '"'mailconf'"' number TEXTSTEM text
 if rc ~= 0 then return
 end

if text.TEXT.COUNT = 0 then return

if head.fromname        ~= "HEAD.FROMNAME"        then text.fromname        = head.fromname
if head.fromaddr        ~= "HEAD.FROMADDR"        then text.fromaddr        = head.fromaddr
if head.toname          ~= "HEAD.TONAME"          then text.toname          = head.toname
if head.toaddr          ~= "HEAD.TOADDR"          then text.toaddr          = head.toaddr
if head.msgid           ~= "HEAD.MSGID"           then text.msgid           = head.msgid
if head.refid           ~= "HEAD.REFID"           then text.refid           = head.refid
if head.creationdate    ~= "HEAD.CREATIONDATE"    then text.creationdate    = head.creationdate
if head.creationdatetxt ~= "HEAD.CREATIONDATETXT" then text.creationdatetxt = head.creationdatetxt
if head.subject         ~= "HEAD.SUBJECT"         then text.subject         = head.subject

do n = 1 to conflist.COUNT+1 while toconf ~= conflist.n
 if n = conflist.COUNT+1 then do
  address(thorport)
  REQUESTNOTIFY '"Non-existant conference: 'toconf'\nDo you want to create it?"' '"_Yes|_No"'
  if result = 1 then do
   address(bbsread)
   CONFIGCONF '"'system'"' '"'toconf'"' SET c2x(CDF_NOT_ON_BBS)
   end
  else return
  end
 end

text.replyconf = mailconf
text.replyaddr = repaddr

if bittst(data.flags,2) then priv = "PRIVATE"
if bittst(data.flags,11) then urg = "URGENT"
if bittst(data.flags,12) then imp = "IMPORTANT"

BUFMODE COPYBACK

WRITEBRMESSAGE '"'system'"' '"'toconf'"' STEM text priv urg imp
if rc ~= 0 then do
 BUFMODE ENDCOPYBACK
 address(thorport)
 REQUESTNOTIFY '"'BBSREAD.LASTERROR'"' '"_Ok"'
 return
 end
mnr = result

if bittst(data.flags, 7) then kep = "SETKEEP"
if bittst(data.flags, 1) then repl = "SETREPLIED"

UPDATEBRMESSAGE '"'system'"' '"'toconf'"' mnr kep repl HAZELEVEL data.HAZELEVEL

UPDATEBRMESSAGE '"'system'"' '"'mailconf'"' number SETDELETED
if rc ~= 0 then do
 address(thorport)
 REQUESTNOTIFY '"Couldn''t delete message #'number':\n'BBSREAD.LASTERROR'"' '"_Ok"'
 address(bbsread)
 end

BUFMODE ENDCOPYBACK
drop data. head. text.
return


parseaminet: procedure expose thorport delnew system mailconf head. rparsed rfiles
             parse arg number

address(thorport)
SAVEMESSAGE BBS '"'system'"' CONFNAME '"'mailconf'"' MSGNUMBER number FILENAME '"T:ParseAminet.tmp"' NOHEADER NOANSI
if rc ~= 0 then return

call open(rf, "T:ParseAminet.tmp")

if left(readln(rf), 1) ~= '|' then do
 address command
 call close(rf)
 'Delete T:ParseAminet.tmp QUIET'
 return
 end

rparsed = rparsed + 1

address(bbsread)
BUFMODE COPYBACK

do until eof(rf)
 aline = readln(rf)
 do while(left(aline, 1) = '|'); aline = readln(rf); end
 if aline ~= "" then do
  farea = word(aline, 2)
  CONFIGFAREA '"'system'"' '"'farea'"'

  fname = word(aline, 1)
  fdesc = right(aline, length(aline) - 35)
  fsize = right(left(aline, 34), 5)
  if(right(fsize, 1) = 'M') then mega = 1
  else mega = 0

  fsize = compress(fsize, 'KM .')

  if(~datatype(fsize, 'W')) then fsize = 0
  fsize = fsize * 1024
  if(mega = 1) then fsize = trunc((fsize * 1024) / 10)

  if(fdesc ~= '') then do
   drop brfile.
   brfile.NAME = fname
   brfile.SIZE = fsize
   brfile.DATE = head.CREATIONDATE
   brfile.DESCRIPTION.COUNT = 1
   brfile.DESCRIPTION.1 = strip(fdesc)
   WRITEBRFILE '"'system'"' '"'farea'"' STEM brfile
   rfiles = rfiles + 1
   end
  end
 end
call close(rf)

address(bbsread)
GETBBSDATA '"'system'"' bbsdata

if delnew = 0 then if exists(bbsdata.BBSPATH'Newfiles.txt') then do
 address(command)
 'Delete "'bbsdata.BBSPATH'Newfiles.txt" QUIET'
 delnew = 1
 end

address(thorport)
SAVEMESSAGE BBS '"'system'"' CONFNAME '"'mailconf'"' MSGNUMBER number FILENAME '"'bbsdata.BBSPATH'Newfiles.txt"' NOHEADER NOANSI

address(bbsread)
UPDATEBRMESSAGE '"'system'"' '"'mailconf'"' number SETDELETED
if rc ~= 0 then do
 address(thorport)
 REQUESTNOTIFY '"Couldn''t delete message #'number':\n'BBSREAD.LASTERROR'"' '"_Ok"'
 address(bbsread)
 end

BUFMODE ENDCOPYBACK

address command
'Delete T:ParseAminet.tmp QUIET'

drop head. data. text.

return


readcfg: procedure expose cfgfile system mailconf aminet amirep checkcc mlist. digest. mlcount dgcount stats

/* Open and read configuration file */
call open(cf, cfgfile, 'R')
do until eof(cf)
 subentry = ""
 entry = readln(cf)
 select
  when upper(entry) = "SYSTEM" then do until upper(subentry) = "END"
   subentry = readln(cf)
   select
    when upper(subword(subentry, 1, 1)) = 'BBS:' then system = subword(subentry, 2)
    when upper(subword(subentry, 1, 1)) = 'CONF:' then mailconf = subword(subentry, 2)
    when upper(subword(subentry, 1, 1)) = 'AMINET:' then aminet = subword(subentry, 2)
    when upper(subword(subentry, 1, 1)) = 'AMIREP:' then amirep = subword(subentry, 2)
    when upper(subword(subentry, 1, 1)) = 'CHECKCC:' then if upper(subword(subentry, 2, 1)) = 'YES' then checkcc = 1
    when upper(subword(subentry, 1, 1)) = 'STATISTICS:' then if upper(subword(subentry, 2, 1)) = 'YES' then stats = 1
    otherwise nop
    end
   end

  when upper(entry) = "MAILLIST" then do
   mlcount = mlcount + 1
   addrs = 0; names = 0
   do until upper(subentry) = "END"
    subentry = readln(cf)
    select
     when upper(subword(subentry, 1, 1)) = 'LISTNAME:' then mlist.mlcount.name = subword(subentry, 2)
     when upper(subword(subentry, 1, 1)) = 'TOADDR:' then do
      addrs = addrs + 1
      mlist.mlcount.toaddr.addrs = subword(subentry, 2)
      end
     when upper(subword(subentry, 1, 1)) = 'TONAME:' then do
      names = names + 1
      mlist.mlcount.toname.names = subword(subentry, 2)
      end
     when upper(subword(subentry, 1, 1)) = 'REPLYADDR:' then mlist.mlcount.replyaddr = subword(subentry, 2)
     otherwise nop
     end
    mlist.mlcount.addrcount = addrs
    mlist.mlcount.namecount = names
    end
   end

  when upper(entry) = "DIGEST" then do
   dgcount = dgcount + 1
   addrs = 0; names = 0
   digest.dgcount.deldigest = 0
   do until upper(subentry) = "END"
    subentry = readln(cf)
    select
     when upper(subword(subentry, 1, 1)) = 'DIGESTNAME:' then digest.dgcount.name = subword(subentry, 2)
     when upper(subword(subentry, 1, 1)) = 'TOADDR:' then do
      addrs = addrs + 1
      digest.dgcount.toaddr.addrs = subword(subentry, 2)
      end
     when upper(subword(subentry, 1, 1)) = 'TONAME:' then do
      names = names + 1
      digest.dgcount.toname.names = subword(subentry, 2)
      end
     when upper(subword(subentry, 1, 1)) = 'REPLYADDR:' then digest.dgcount.replyaddr = subword(subentry, 2)
     when upper(subword(subentry, 1, 1)) = 'ENDSUBMSG:' then digest.dgcount.endsubmsg = subword(subentry, 2)
     when upper(subword(subentry, 1, 1)) = 'ENDDIGEST:' then digest.dgcount.enddigest = subword(subentry, 2)
     when upper(subword(subentry, 1, 1)) = 'DELDIGEST:' then if upper(subword(subentry, 2, 1)) = 'YES' then digest.dgcount.deldigest = 1
     otherwise nop
     end
    digest.dgcount.addrcount = addrs
    digest.dgcount.namecount = names
    end
   end
  otherwise nop
  end
 end
call close(cf)
return

cleanup: procedure expose progwin thorport

address(bbsread)
BUFMODE ENDCOPYBACK

if progwin ~= 0 then do
 address(thorport)
 CLOSEPROGRESS REQ progwin
 end

if exists("T:SortMail.tmp") then do
 address(command)
 "Delete T:SortMail.tmp QUIET"
 end

exit(0)